個人總貸款預測

rm(list = ls(all = T)); invisible(gc())
pacman::p_load(bit64, skimr, lubridate, dplyr, ggplot2, plotly,forecast, DescTools)

df <- data.table::fread("Total_Amt.CSV", encoding = "UTF-8")

View(df)
colnames(df)[4] <- c("個人貸款總金額")

str(df)

Classes ‘data.table’ and 'data.frame':  115 obs. of  8 variables:
 $ 年                            : int  2012 2012 2012 2012 2012 2012 2012 2012 2012 2012 ...
 $ 月                            : int  1 2 3 4 5 6 7 8 9 10 ...
 $ 個人貸款總人數                : int  4742543 4728534 4716591 4714865 4712690 4703118 4687842 4679800 4673062 4665381 ...
 $ 個人貸款總金額                :integer64 10431407540 10426760702 10449619069 10492731783 10554011059 10612688184 10666664825 10686581979 ... 
 $ 個人貸款平均金額[仟元]        : num  2200 2205 2216 2225 2239 ...
 $ 個人貸款金額第25百分位數[仟元]: int  195 195 196 199 203 204 207 208 208 209 ...
 $ 個人貸款金額第50百分位數[仟元]: int  660 661 664 665 669 675 681 684 687 689 ...
 $ 個人貸款金額第75百分位數[仟元]: int  2249 2250 2255 2261 2271 2285 2300 2308 2316 2325 ...
 - attr(*, ".internal.selfref")=<externalptr> 

df$`個人貸款總金額` <- as.numeric(df$`個人貸款總金額`)
class(df$`個人貸款總金額`)

[1] "numeric"

# date <- format(ym(paste0(df$年, df$月)), "%Y%m")
date <- ym(paste0(df$年, df$月))

df_trend <- cbind(data.frame(date), df$`個人貸款總金額`)
colnames(df_trend)[2] <- c("個人貸款總金額")
df_trend$個人貸款總金額 <- as.numeric(df_trend$個人貸款總金額)

trend <- ggplot(df_trend, aes(x = date, y = 個人貸款總金額, group = 1)) + 
  geom_line(size = 1.5)
ggplotly(trend)

trend <- df_trend$個人貸款總金額
trend <- ts(trend, start = 2012, end = 2021, frequency = 12)
trend

             Jan         Feb         Mar         Apr
2012 10431407540 10426760702 10449619069 10492731783
2013 10900252120 10889092166 10927332840 10998711218
2014 11723603289 11729842290 11795144307 11869858131
2015 12492638555 12504735310 12536890912 12580510141
2016 13013352569 12980959870 12986263833 13013115186
2017 13465719657 13458592550 13507741237 13562545251
2018 14112589805 14112204855 14159231965 14210464487
2019 14779119617 14759331132 14798610851 14851205627
2020 15482324785 15525873997 15623873002 15718182842
2021 16837409007                                    
             May         Jun         Jul         Aug
2012 10554011059 10612688184 10666664825 10686581979
2013 11087882711 11173257139 11250521573 11307060047
2014 11963673485 12054758532 12115450849 12208532175
2015 12639077389 12700880700 12737829993 12760188691
2016 13072078075 13131918107 13170446798 13202231080
2017 13628634131 13724973556 13753166807 13796727742
2018 14291810341 14368123297 14422897374 14472124520
2019 14933110233 15003565977 15081188852 15119122269
2020 15869479862 16006143850 16107969442 16207752601
2021                                                
             Sep         Oct         Nov         Dec
2012 10721490749 10757184076 10807564146 10890880112
2013 11382120740 11458709995 11549787046 11681691680
2014 12268379158 12319005676 12356037878 12467879674
2015 12785977652 12818502359 12874948555 13037289742
2016 13249395213 13292313242 13361453322 13467500155
2017 13846505190 13889028926 13972429502 14075489725
2018 14530810008 14596792920 14671421339 14762977072
2019 15177518025 15262332956 15362181885 15485349913
2020 16327691969 16426815517 16570806778 16755588970
2021                                                

plot(trend)

acf(trend)

pacf(trend)

model <- auto.arima(x = trend)

Having 3 or more differencing operations is not recommended. Please consider reducing the total number of differences.

model

Series:  
ARIMA(2,2,1)(2,1,1)[12] 

Coefficients:
         ar1      ar2      ma1    sar1     sar2     sma1
      0.0130  -0.0227  -0.6419  0.0252  -0.1770  -0.8664
s.e.  0.1772   0.1337   0.1359  0.1601   0.1446   0.2798

sigma^2 estimated as 3.608e+14:  log likelihood=-1735.76
AIC=3485.52   AICc=3486.81   BIC=3503.4

acf(model$residuals)

pacf(model$residuals)

result <- predict(model, n.ahead = 6, se.fit = TRUE)
result

$pred
             Feb         Mar         Apr         May
2021 16908721781 17024487394 17150921230 17304754491
             Jun         Jul
2021 17459336682 17583737545

$se
          Feb      Mar      Apr      May      Jun      Jul
2021 19275942 32746065 46525199 61278977 77059241 93841141

cat(paste0("MAPE = ", mape, "\n", "SMAPE = ", smape))

MAPE = 0.00550682245249073
SMAPE = 0.00549051036681183

theForecast <- forecast(model, h = 6)
plot(theForecast, main = "ARIMA預測結果", xlab = "年", ylab = "個人總貸款金額(仟元)")